home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / cgi386ad.inc < prev    next >
Text File  |  1998-09-24  |  58KB  |  1,287 lines
  1. {
  2.     $Id: cgi386ad.inc,v 1.2.2.1 1998/04/08 11:38:43 peter Exp $
  3.     Copyright (c) 1993-98 by Florian Klaempfl
  4.  
  5.     This include file generates i386+ assembler from the parse tree
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23.  
  24.     procedure secondas(var p : ptree);
  25.  
  26.       var
  27.          pushed : tpushed;
  28.  
  29.       begin
  30.          secondpass(p^.left);
  31.          { save all used registers }
  32.          pushusedregisters(pushed,$ff);
  33.  
  34.          { push instance to check: }
  35.          case p^.left^.location.loc of
  36.             LOC_REGISTER,LOC_CREGISTER:
  37.               exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  38.                 S_L,p^.left^.location.register)));
  39.             LOC_MEM,LOC_REFERENCE:
  40.               exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  41.                 S_L,newreference(p^.left^.location.reference))));
  42.             else internalerror(100);
  43.          end;
  44.  
  45.          { we doesn't modifiy the left side, we check only the type }
  46.          set_location(p^.location,p^.left^.location);
  47.  
  48.          { generate type checking }
  49.          secondpass(p^.right);
  50.          case p^.right^.location.loc of
  51.             LOC_REGISTER,LOC_CREGISTER:
  52.               begin
  53.                  exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  54.                    S_L,p^.right^.location.register)));
  55.                  ungetregister32(p^.right^.location.register);
  56.               end;
  57.             LOC_MEM,LOC_REFERENCE:
  58.               begin
  59.                  exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  60.                    S_L,newreference(p^.right^.location.reference))));
  61.                  del_reference(p^.right^.location.reference);
  62.               end;
  63.             else internalerror(100);
  64.          end;
  65.          emitcall('DO_AS',true);
  66.          { restore register, this restores automatically the }
  67.          { result                                            }
  68.          popusedregisters(pushed);
  69.       end;
  70.  
  71.     procedure secondloadvmt(var p : ptree);
  72.  
  73.       begin
  74.          p^.location.register:=getregister32;
  75.          exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
  76.             S_L,newcsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname,0),
  77.             p^.location.register)));
  78.       end;
  79.  
  80.     procedure secondis(var p : ptree);
  81.  
  82.       var
  83.          pushed : tpushed;
  84.  
  85.       begin
  86.          { save all used registers }
  87.          pushusedregisters(pushed,$ff);
  88.          secondpass(p^.left);
  89.          p^.location.loc:=LOC_FLAGS;
  90.          p^.location.resflags:=F_NE;
  91.  
  92.          { push instance to check: }
  93.          case p^.left^.location.loc of
  94.             LOC_REGISTER,LOC_CREGISTER:
  95.               begin
  96.                  exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  97.                    S_L,p^.left^.location.register)));
  98.                  ungetregister32(p^.left^.location.register);
  99.               end;
  100.             LOC_MEM,LOC_REFERENCE:
  101.               begin
  102.                  exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  103.                    S_L,newreference(p^.left^.location.reference))));
  104.                  del_reference(p^.left^.location.reference);
  105.               end;
  106.             else internalerror(100);
  107.          end;
  108.  
  109.          { generate type checking }
  110.          secondpass(p^.right);
  111.          case p^.right^.location.loc of
  112.             LOC_REGISTER,LOC_CREGISTER:
  113.               begin
  114.                  exprasmlist^.concat(new(pai386,op_reg(A_PUSH,
  115.                    S_L,p^.right^.location.register)));
  116.                  ungetregister32(p^.right^.location.register);
  117.               end;
  118.             LOC_MEM,LOC_REFERENCE:
  119.               begin
  120.                  exprasmlist^.concat(new(pai386,op_ref(A_PUSH,
  121.                    S_L,newreference(p^.right^.location.reference))));
  122.                  del_reference(p^.right^.location.reference);
  123.               end;
  124.             else internalerror(100);
  125.          end;
  126.          emitcall('DO_IS',true);
  127.          exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_B,R_AL,R_AL)));
  128.          popusedregisters(pushed);
  129.       end;
  130.  
  131.     procedure setaddresult(cmpop,unsigned : boolean;var p :ptree);
  132.       var
  133.          flags : tresflags;
  134.       begin
  135.          if (p^.left^.resulttype^.deftype<>stringdef) and
  136.             not ((p^.left^.resulttype^.deftype=setdef) and
  137.                (psetdef(p^.left^.resulttype)^.settype<>smallset)) then
  138.            begin
  139.               { this can be useful if for instance length(string) is called }
  140.               if (p^.left^.location.loc=LOC_REFERENCE) or
  141.                  (p^.left^.location.loc=LOC_MEM) then
  142.                 ungetiftemp(p^.left^.location.reference);
  143.               if (p^.right^.location.loc=LOC_REFERENCE) or
  144.                  (p^.right^.location.loc=LOC_MEM) then
  145.                 ungetiftemp(p^.right^.location.reference);
  146.            end;
  147.          { in case of comparison operation the put result in the flags }
  148.          if cmpop then
  149.            begin
  150.               if not(unsigned) then
  151.                 begin
  152.                    if p^.swaped then
  153.                      case p^.treetype of
  154.                         equaln : flags:=F_E;
  155.                         unequaln : flags:=F_NE;
  156.                         ltn : flags:=F_G;
  157.                         lten : flags:=F_GE;
  158.                         gtn : flags:=F_L;
  159.                         gten : flags:=F_LE;
  160.                      end
  161.                    else
  162.                      case p^.treetype of
  163.                         equaln : flags:=F_E;
  164.                         unequaln : flags:=F_NE;
  165.                         ltn : flags:=F_L;
  166.                         lten : flags:=F_LE;
  167.                         gtn : flags:=F_G;
  168.                         gten : flags:=F_GE;
  169.                      end;
  170.                 end
  171.               else
  172.                 begin
  173.                    if p^.swaped then
  174.                      case p^.treetype of
  175.                         equaln : flags:=F_E;
  176.                         unequaln : flags:=F_NE;
  177.                         ltn : flags:=F_A;
  178.                         lten : flags:=F_AE;
  179.                         gtn : flags:=F_B;
  180.                         gten : flags:=F_BE;
  181.                      end
  182.                    else
  183.                      case p^.treetype of
  184.                         equaln : flags:=F_E;
  185.                         unequaln : flags:=F_NE;
  186.                         ltn : flags:=F_B;
  187.                         lten : flags:=F_BE;
  188.                         gtn : flags:=F_A;
  189.                         gten : flags:=F_AE;
  190.                      end;
  191.                 end;
  192.               p^.location.loc:=LOC_FLAGS;
  193.               p^.location.resflags:=flags;
  194.            end;
  195.       end;
  196.  
  197.  
  198.   procedure secondaddstring(var p : ptree);
  199.  
  200.     var
  201.        swapp : ptree;
  202.        pushedregs : tpushed;
  203.        href : treference;
  204.        pushed,cmpop : boolean;
  205.  
  206.     begin
  207.        { string operations are not commutative }
  208.        if p^.swaped then
  209.          begin
  210.             swapp:=p^.left;
  211.             p^.left:=p^.right;
  212.             p^.right:=swapp;
  213.             { because of jump being produced at comparison below: }
  214.             p^.swaped:=not(p^.swaped);
  215.          end;
  216.        case p^.treetype of
  217.           addn :
  218.             begin
  219.                cmpop:=false;
  220.                secondpass(p^.left);
  221.                if (p^.left^.treetype<>addn) then
  222.                  begin
  223.                     { can only reference be }
  224.                     { string in register would be funny    }
  225.                     { therefore produce a temporary string }
  226.  
  227.                     { release the registers }
  228.                     del_refere